home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
byte0687.arc
/
COMPRES.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-03-25
|
2KB
|
55 lines
{COMPRESS.PAS is a procedure written in Turbo Pascal for the IBM PC
and its compatibles for the purpose of compressing screen data.
It is not a stand-alone program.}
procedure Compress;
const escapechar = $F800;
scrnseg = $B800;
scrnsize = 4000;
var OutputFile: Text;
OutputFileName: string[80];
runlength,currentword,nextword,scrnofs,items: integer;
begin
OutputFileName := paramSTR(1);
Assign(OutputFile, OutputFileName);
Rewrite(OutputFile);
write(OutputFile,'(');
items := 0;
scrnofs := 0;
currentword := MemW[scrnseg:scrnofs]; {read word from screen memory}
scrnofs := scrnofs + 2;
repeat
runlength := 0;
repeat
nextword := MemW[scrnseg:scrnofs];
scrnofs := scrnofs + 2;
runlength := runlength + 1;
until (nextword <> currentword) or (scrnofs > scrnsize);
if runlength > 1
then begin {it's count/value}
runlength := escapechar or runlength; {set 'escape' bits}
write(OutputFile,runlength,',',currentword,',');
if (items mod 12) >= 10 {format into lines}
then writeln(OutputFile);
items := items + 2
end
else begin {it's a singleton}
write(OutputFile,currentword,',');
if (items mod 12) >= 11
then writeln(OutputFile);
items := items + 1
end;
currentword := nextword
until scrnofs > scrnsize;
write(OutputFile,'*** ',items,' items ***);');
Close(OutputFile);
writeln('Compressed data written to ',OutputFileName)
end;
OutputFile,'*** ',items,' items ***);');
Close(OutputFile);
writeln('Compressed data written to ',OutputFileName)
end